home *** CD-ROM | disk | FTP | other *** search
/ Mac Easy 2010 May / Mac Life Ubuntu.iso / casper / filesystem.squashfs / usr / share / emacs / site-lisp / dictionaries-common / debian-ispell.el next >
Encoding:
Text File  |  2009-02-20  |  16.8 KB  |  440 lines
  1. ;; File: debian-ispell.el
  2. ;; -----------------------------------------------------------------------
  3. ;; Description: Emacsen support for Debian package dictionaries-common
  4. ;; Authors: Rafael LaboissiËre <rafael@debian.org>
  5. ;;          Agustin Martin     <agmartin@debian.org>
  6. ;; Created on: Tue Oct 26 10:16:12 CEST 1999
  7. ;; -----------------------------------------------------------------------
  8.  
  9. (defcustom debian-dict-common-debug nil
  10.   "A lot of debugging info will be shown if non nil."
  11.   :type 'boolean
  12.   :group 'ispell)
  13.  
  14. (defvar debian-ispell-only-dictionary-alist nil
  15.   "Alist of Debian installed ispell dicts and properties.
  16. Its value will be used to set `ispell-dictionary-alist' after
  17. ispell.el is loaded when ispell is in use.
  18. Do not change this variable directly. It is autogenerated
  19. from data supplied by ispell dictionaries maintainers.")
  20.  
  21. (defvar debian-aspell-only-dictionary-alist nil
  22.   "Alist of Debian installed aspell dicts and properties.
  23. Its value will be used to set `ispell-dictionary-alist' after
  24. ispell.el is loaded when aspell is in use.
  25. Do not change this variable directly. It is autogenerated
  26. from data supplied by aspell dictionaries maintainers.")
  27.  
  28. (defvar debian-hunspell-only-dictionary-alist nil
  29.   "Alist of Debian installed hunspell dicts and properties.
  30. Its value will be used to set `ispell-dictionary-alist' after
  31. ispell.el is loaded when hunspell is in use.
  32. Do not change this variable directly. It is autogenerated
  33. from data supplied by hunspell dictionaries maintainers.")
  34.  
  35. (defvar debian-ispell-valid-dictionary-list nil
  36.   "List of registered ispell, aspell or hunspell dicts.
  37. Will be used to set the dictionaries pop-up menu.")
  38.  
  39. (defun debian-ispell-add-dictionary-entry (entry &optional name)
  40.   "Obsolete function!!. Entries in ~/.emacs must be adapted to
  41. modify `ispell-local-dictionary-alist'"
  42.   (message "`debian-ispell-add-dictionary-entry': Obsolete function!!.
  43. Entries in ~/.emacs must be adapted to modify `ispell-local-dictionary-alist'.
  44. See dictionaries-common README.emacs")
  45.   )
  46.  
  47. ;;; ----------------------------------------------------------------------
  48. ;;;  Handle ispell.el load at startup
  49. ;;; ----------------------------------------------------------------------
  50.  
  51. (defun debian-ispell-build-startup-menu (mylist)
  52. ;;; ----------------------------------------------------------------------
  53. ;;; Extracted from ispell.el, by Ken Stevens, part of GNU emacs.
  54. ;;; Original code released under the GNU GPL license
  55. ;;; ----------------------------------------------------------------------
  56.   "Build startup menu, trying to not explicitely load ispell.el"
  57.   (if ispell-menu-map-needed
  58.       (let ((dicts (reverse mylist)))
  59.     (setq ispell-menu-map (make-sparse-keymap "Spell"))
  60.     ;; add the dictionaries to the bottom of the list.
  61.     (dolist (name dicts)
  62.       (if (string-equal "default" name)
  63.           (define-key ispell-menu-map (vector 'default)
  64.         (cons "Select Default Dict"
  65.               (cons "Dictionary for which Ispell was configured"
  66.                 (list 'lambda () '(interactive)
  67.                   (list
  68.                    'ispell-change-dictionary "default")))))
  69.         (define-key ispell-menu-map (vector (intern name))
  70.           (cons (concat "Select " (capitalize name) " Dict")
  71.             (list 'lambda () '(interactive)
  72.               (list 'ispell-change-dictionary name))))))))
  73.  
  74.   (if ispell-menu-map-needed
  75.       (progn
  76.     (define-key ispell-menu-map [ispell-change-dictionary]
  77.       '(menu-item "Change Dictionary..." ispell-change-dictionary
  78.               :help "Supply explicit dictionary file name"))
  79.     ;; --
  80.     (define-key ispell-menu-map [ispell-kill-ispell]
  81.       '(menu-item "Kill Process" ispell-kill-ispell
  82.               :enable (and (boundp 'ispell-process) ispell-process
  83.                     (eq (ispell-process-status) 'run))
  84.               :visible (featurep 'ispell)
  85.               :help "Terminate Ispell subprocess"))
  86.     ;; --
  87.     (define-key ispell-menu-map [ispell-pdict-save]
  88.       '(menu-item "Save Dictionary"
  89.                (lambda () (interactive) (ispell-pdict-save t t))
  90.               :visible (featurep 'ispell)
  91.                :help "Save personal dictionary"))
  92.     ;; --
  93.     (define-key ispell-menu-map [ispell-customize]
  94.       '(menu-item "Customize..."
  95.               (lambda () (interactive) (customize-group 'ispell))
  96.               :help "Customize spell checking options"))
  97.     ;; --
  98.     (define-key ispell-menu-map [ispell-help]
  99.       ;; use (x-popup-menu last-nonmenu-event(list "" ispell-help-list)) ?
  100.       '(menu-item "Help"
  101.               (lambda () (interactive) (describe-function 'ispell-help))
  102.               :help "Show standard Ispell keybindings and commands"))
  103.     ;; --
  104.     (define-key ispell-menu-map [flyspell-mode]
  105.       '(menu-item "Automatic spell checking (Flyspell)"
  106.               flyspell-mode
  107.               :help "Check spelling while you edit the text"
  108.               :button (:toggle . (and (boundp 'flyspell-mode)
  109.                           flyspell-mode))))
  110.     ;; --
  111.     (define-key ispell-menu-map [ispell-complete-word]
  112.       '(menu-item "Complete Word" ispell-complete-word
  113.               :help "Complete word at cursor using dictionary"))
  114.     ;; --
  115.     (define-key ispell-menu-map [ispell-complete-word-interior-frag]
  116.       '(menu-item "Complete Word Fragment" ispell-complete-word-interior-frag
  117.               :help "Complete word fragment at cursor"))))
  118.  
  119.   (if ispell-menu-map-needed
  120.       (progn
  121.     (define-key ispell-menu-map [ispell-continue]
  122.       '(menu-item "Continue Spell-Checking" ispell-continue
  123.                :enable (and (boundp 'ispell-region-end)
  124.                    (marker-position ispell-region-end)
  125.                    (equal (marker-buffer ispell-region-end)
  126.                       (current-buffer)))
  127.               :visible (featurep 'ispell)
  128.                :help "Continue spell checking last region"))
  129.     ;; --
  130.     (define-key ispell-menu-map [ispell-word]
  131.       '(menu-item "Spell-Check Word" ispell-word
  132.               :help "Spell-check word at cursor"))
  133.     ;; --
  134.     (define-key ispell-menu-map [ispell-comments-and-strings]
  135.       '(menu-item "Spell-Check Comments" ispell-comments-and-strings
  136.               :help "Spell-check only comments and strings"))))
  137.  
  138.  
  139.   (if ispell-menu-map-needed
  140.       (progn
  141.     (define-key ispell-menu-map [ispell-region]
  142.       '(menu-item "Spell-Check Region" ispell-region
  143.               :enable mark-active
  144.               :help "Spell-check text in marked region"))
  145.     (define-key ispell-menu-map [ispell-message]
  146.       '(menu-item "Spell-Check Message" ispell-message
  147.               :visible (eq major-mode 'mail-mode)
  148.               :help "Skip headers and included message text"))
  149.     (define-key ispell-menu-map [ispell-buffer]
  150.       '(menu-item "Spell-Check Buffer" ispell-buffer
  151.               :help "Check spelling of selected buffer"))
  152.     ;;(put 'ispell-region 'menu-enable 'mark-active)
  153.     (fset 'ispell-menu-map (symbol-value 'ispell-menu-map))))
  154.  
  155.   (if (and (featurep 'xemacs)
  156.        (featurep 'menubar)
  157.        ;;(null ispell-menu-xemacs)
  158.        (not (and (boundp 'infodock-version) infodock-version)))
  159.       (let ((dicts mylist)
  160.         (current-menubar (or current-menubar default-menubar))
  161.         (menu
  162.          '(["Help"        (describe-function 'ispell-help) t]
  163.         ;;["Help"        (popup-menu ispell-help-list)    t]
  164.         ["Check Message"       ispell-message (eq major-mode 'mail-mode)]
  165.         ["Check Buffer"           ispell-buffer                t]
  166.         ["Check Comments"      ispell-comments-and-strings        t]
  167.         ["Check Word"           ispell-word                t]
  168.         ["Check Region"           ispell-region  (or (not zmacs-regions) (mark))]
  169.         ["Continue Check"      ispell-continue          (featurep 'ispell)]
  170.         ["Complete Word Frag"  ispell-complete-word-interior-frag   t]
  171.         ["Complete Word"       ispell-complete-word            t]
  172.         ["Kill Process"           ispell-kill-ispell     (featurep 'ispell)]
  173.         ["Customize..."           (customize-group 'ispell)        t]
  174.         ;; flyspell-mode may not be bound...
  175.         ["flyspell"           flyspell-mode
  176.         :style toggle :selected flyspell-mode ]
  177.         "-"
  178.         ["Save Personal Dict"  (ispell-pdict-save t t)(featurep 'ispell)]
  179.         ["Change Dictionary"   ispell-change-dictionary    t])))
  180.     (if (null dicts)
  181.         (setq dicts (cons "default" nil)))
  182.     (dolist (name dicts)
  183.       (setq menu (append menu
  184.                  (list
  185.                   (vector
  186.                    (concat "Select " (capitalize name))
  187.                    (list 'ispell-change-dictionary name)
  188.                    t)))))
  189.     (setq ispell-menu-xemacs menu)
  190.     (if current-menubar
  191.         (progn
  192.           (if (car (find-menu-item current-menubar '("Cmds")))
  193.           (progn
  194.             ;; XEmacs 21.2
  195.             (delete-menu-item '("Cmds" "Spell-Check"))
  196.             (add-menu '("Cmds") "Spell-Check" ispell-menu-xemacs))
  197.         ;; previous
  198.         (delete-menu-item '("Edit" "Spell")) ; in case already defined
  199.         (add-menu '("Edit") "Spell" ispell-menu-xemacs))))))
  200.  
  201.   )
  202.  
  203. (defun debian-ispell-set-startup-menu (&optional force)
  204.   "Make sure ispell startup menu is ready after startup.
  205. To be run at `after-init-hook' or at any time if FORCE is given."
  206.   ;; I know let* is cleaner, but this helps debugging
  207.   (let (really-aspell
  208.     really hunspell
  209.     debian-valid-dictionary-list
  210.     dicts-list)
  211.  
  212.     ;; Check for spellchecker engine
  213.     (or (setq really-aspell
  214.           (if (boundp 'ispell-really-aspell)
  215.           ispell-really-aspell
  216.         (and (boundp 'ispell-program-name)
  217.              (string-match "aspell" ispell-program-name)
  218.              t)))
  219.     (setq really-hunspell
  220.           (if (boundp 'ispell-really-hunspell)
  221.           ispell-really-hunspell
  222.         (and (boundp 'ispell-program-name)
  223.              (string-match "hunspell" ispell-program-name)
  224.              t))))
  225.  
  226.     ;; Get list of registered for given spellchecker
  227.     (setq debian-valid-dictionary-list
  228.       (if really-aspell
  229.           (mapcar 'car debian-aspell-only-dictionary-alist)
  230.         (if really-hunspell
  231.         (mapcar 'car debian-hunspell-only-dictionary-alist)
  232.           (mapcar 'car debian-ispell-only-dictionary-alist))))
  233.  
  234.     ;; Get full list of dicts to be displayed in the menu
  235.     (setq dicts-list
  236.       (if (boundp 'ispell-local-dictionary-alist)
  237.           (append (mapcar 'car ispell-local-dictionary-alist)
  238.               debian-valid-dictionary-list)
  239.         debian-valid-dictionary-list))
  240.  
  241.     (if (and (featurep 'ispell)
  242.          (not force))
  243.     (message "ispell.el is already loaded")
  244.       (when (fboundp 'debian-ispell-build-startup-menu)
  245.     (debian-ispell-build-startup-menu dicts-list)
  246.     ;; (fmakunbound 'debian-ispell-build-startup-menu)
  247.     ))))
  248.  
  249. ;; Make sure updated Debian menu is available after emacs is started
  250. (add-hook 'after-init-hook 'debian-ispell-set-startup-menu)
  251.  
  252. ;; Make sure updated Debian menu is not overriden by ispell.el one
  253. (eval-after-load "ispell" '(debian-ispell-set-startup-menu))
  254.  
  255. ;;; -----------------------------------------------------------------------
  256. ;;;  Guess default ispell dictionary under emacs and make ispell.el use it
  257. ;;; -----------------------------------------------------------------------
  258.  
  259. (defvar debian-ispell-dictionary
  260.   nil
  261.   "The name of the ispell dictionary that will become the default after
  262. loading of ispell.el.")
  263.  
  264. ;; ---------------------------------------------------------------------------
  265. ;; Load the file containing the default value for debian-ispell-dictionary
  266. ;; ---------------------------------------------------------------------------
  267.  
  268. (if (file-exists-p "/var/cache/dictionaries-common/emacsen-ispell-default.el")
  269.     (load "/var/cache/dictionaries-common/emacsen-ispell-default.el"))
  270.  
  271. ;;; ----------------
  272.  
  273. (defvar debian-aspell-dictionary
  274.   nil
  275.   "The name of the aspell dictionary that will become the default after
  276. loading of ispell.el.")
  277.  
  278. (defvar debian-hunspell-dictionary
  279.   nil
  280.   "The name of the hunspell dictionary that will become the default after
  281. loading of ispell.el.")
  282.  
  283. (defvar debian-aspell-equivs-alist
  284.   '((nil . nil))
  285.   "Alist of equivalences between locales and aspell dictionaries,
  286. used internally by the debian ispell.el initialization scheme.
  287. Do not change this variable directly. It is autogenerated
  288. from data supplied by aspell dictionaries maintainers.")
  289.  
  290. (defvar debian-hunspell-equivs-alist
  291.   '((nil . nil))
  292.   "Alist of equivalences between locales and hunspell dictionaries,
  293. used internally by the debian ispell.el initialization scheme.
  294. Do not change this variable directly. It is autogenerated
  295. from data supplied by hunspell dictionaries maintainers.")
  296.  
  297. ;; ---------------------------------------------------------------------------
  298. ;; Guess emacsen entry for aspell and hunspell after locale provided by aspell
  299. ;; or after environment variables LC_ALL and LANG for hunspell
  300. ;; Intended to be called from /var/cache/emacsen-ispell-dicts.el
  301. ;; to set debian-{a,huns}spell-dictionary if possible
  302. ;; ---------------------------------------------------------------------------
  303.  
  304. (defun debian-ispell-try-lang-equiv (langstring equivs-alist)
  305.   "Try finding a LANGSTRING match in EQUIVS-ALIST.
  306. EQUIVS-ALIST is an assoc list of locales vs dict names."
  307.   (let ((prefixes  '("" "1:"))
  308.     (suffixes  '("^" "@" "." "_"))
  309.     (langmatch '(nil nil)))
  310.  
  311.     (if langstring
  312.     (catch 'tag
  313.       (dolist (lang (split-string langstring ":"))
  314.         (dolist (suffix suffixes)
  315.           (dolist (prefix prefixes)
  316.         (if (setq langmatch
  317.               (cdr (assoc (concat prefix
  318.                           (car (split-string lang suffix)))
  319.                       equivs-alist)))
  320.             (throw 'tag (car langmatch))))))))))
  321.  
  322.  
  323. (defun debian-ispell-get-aspell-default ()
  324.   "Get default dictionary for aspell.
  325. Ask aspell about the default dictionary it will use, and
  326. try finding a match for it in `debian-aspell-equivs-alist'
  327. alist provided by registered dicts."
  328.   (let ((lang (condition-case ()
  329.           (with-temp-buffer
  330.             (call-process "aspell" nil t nil "config" "lang")
  331.             (car (split-string (buffer-string))))
  332.         (error nil))))
  333.  
  334.     (debian-ispell-try-lang-equiv lang debian-aspell-equivs-alist)))
  335.  
  336. (defun debian-ispell-get-hunspell-default ()
  337.   "Get default dictionary for hunspell.
  338. Look at the `debian-aspell-equivs-alist' alist provided by registered
  339. dicts to try finding a match for \"LC_ALL\" or \"LANG\"."
  340.   (or (debian-ispell-try-lang-equiv (getenv "LC_ALL") debian-hunspell-equivs-alist)
  341.       (debian-ispell-try-lang-equiv (getenv "LANG")   debian-hunspell-equivs-alist)))
  342.  
  343. ;; ---------------------------------------------------------------------------
  344. ;; Make sure the correct installed dicts alist is used for each spellchecker
  345. ;; This hook will be run after each change in `ispell-program-name'
  346. ;; ---------------------------------------------------------------------------
  347.  
  348. (defun debian-ispell-initialize-dicts-alist ()
  349.   (setq ispell-base-dicts-override-alist
  350.     (if (and (boundp 'ispell-really-aspell)
  351.          ispell-really-aspell)
  352.         debian-aspell-only-dictionary-alist
  353.       (if (and (boundp 'ispell-really-hunspell)
  354.            ispell-really-hunspell)
  355.           debian-hunspell-only-dictionary-alist
  356.         debian-ispell-only-dictionary-alist)))
  357.   (setq debian-ispell-valid-dictionary-list
  358.     (mapcar 'car ispell-base-dicts-override-alist))
  359.   (debian-ispell-set-startup-menu 'force)
  360.   (if debian-dict-common-debug
  361.       (message "- (ispell-set-spellchecker-params) old: %s new:%s"
  362.            ispell-last-program-name ispell-program-name))
  363.   )
  364.  
  365. (add-hook 'ispell-initialize-spellchecker-hook 'debian-ispell-initialize-dicts-alist)
  366.  
  367. ;;; --------------
  368.  
  369. (defun debian-ispell-set-default-dictionary ()
  370.   "Set ispell default to the debconf selected one if ispell-program-name is
  371. ispell or, when ispell-program-name is aspell, to the value guessed after
  372. LANG if any."
  373.   (let ((really-aspell
  374.      (if (boundp 'ispell-really-aspell)
  375.          ispell-really-aspell
  376.        (and (boundp 'ispell-program-name)
  377.         (string-match "aspell" ispell-program-name)
  378.         t)))
  379.     (really-hunspell
  380.      (if (boundp 'ispell-really-hunspell)
  381.          ispell-really-hunspell
  382.        (and (boundp 'ispell-program-name)
  383.         (string-match "hunspell" ispell-program-name)
  384.         t))))
  385.  
  386.     ;; Set local dictionary if known
  387.     (unless (and (boundp 'ispell-local-dictionary)
  388.          ispell-local-dictionary)
  389.       (setq ispell-local-dictionary
  390.         (if really-aspell
  391.         debian-aspell-dictionary
  392.           (if really-hunspell
  393.           debian-hunspell-dictionary
  394.         debian-ispell-dictionary))))
  395.  
  396.     ;; The debugging output if required
  397.  
  398.     (if debian-dict-common-debug
  399.     (message "- dictionaries DID:%s, DAD:%s, DHD: %s, RA:%s, RH: %s, ILD:%s, IPN:%s"
  400.          debian-ispell-dictionary
  401.          debian-aspell-dictionary
  402.          debian-hunspell-dictionary
  403.          really-aspell
  404.          really-hunspell
  405.          ispell-local-dictionary
  406.          ispell-program-name))
  407.     )) ;; let and defun ends
  408.  
  409. (add-hook 'after-init-hook 'debian-ispell-set-default-dictionary)
  410.  
  411. ;; ---------------------------------------------------------------------------
  412. ;; Make sure patched ispell.el is first in the loadpath if not already there
  413. ;; ---------------------------------------------------------------------------
  414.  
  415. (let ((mypath (concat "/usr/share/"
  416.               (symbol-name debian-emacs-flavor)
  417.               "/site-lisp/dictionaries-common")))
  418.   (unless (member mypath load-path)
  419.     (debian-pkg-add-load-path-item mypath)))
  420.  
  421. ;; --------------------------------------------------------------------------
  422. ;; Set ispell-program-name consistently for all emacsen flavours, preferring
  423. ;; ispell over aspell for backwards compatibility
  424. ;; --------------------------------------------------------------------------
  425.  
  426. (setq ispell-program-name
  427.       (or (and (executable-find "aspell")
  428.            (not (executable-find "ispell"))
  429.            "aspell")
  430.       (and (executable-find "hunspell")
  431.            (not (executable-find "ispell"))
  432.            "hunspell")
  433.       "ispell"))
  434.  
  435. ;;; -----------------------------------------------------------------------
  436.  
  437. ;; Local Variables:
  438. ;; mode: lisp
  439. ;; End:
  440.